home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / amigaunits / workbench.pas < prev   
Pascal/Delphi Source File  |  2000-01-01  |  11KB  |  378 lines
  1. {
  2.     This file is part of the Free Pascal run time library.
  3.  
  4.     A file in Amiga system run time library.
  5.     Copyright (c) 1998-2000 by Nils Sjoholm
  6.     member of the Amiga RTL development team.
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16. {
  17.     History:
  18.     Added overlay functions for Pchar->Strings, functions
  19.     and procedures.
  20.  
  21.     14 Jul 2000.
  22.     nils.sjoholm@mailbox.swipnet.se
  23. }
  24.  
  25. unit workbench;
  26.  
  27. INTERFACE
  28.  
  29. {$I amigaoverlays.inc}
  30.  
  31. uses exec,amigados,utility, intuition;
  32.  
  33.  
  34.  
  35. Type
  36.  
  37.     pWBArg = ^tWBArg;
  38.     tWBArg = record
  39.         wa_Lock         : Pointer;      { a lock descriptor }
  40.         wa_Name         : STRPTR;       { a string relative to that lock }
  41.     end;
  42.  
  43.     WBArgList = Array [1..100] of tWBArg; { Only 1..smNumArgs are valid }
  44.     pWBArgList = ^WBArgList;
  45.  
  46.  
  47.     pWBStartup = ^tWBStartup;
  48.     tWBStartup = record
  49.         sm_Message      : tMessage;      { a standard message structure }
  50.         sm_Process      : pMsgPort;   { the process descriptor for you }
  51.         sm_Segment      : BPTR;         { a descriptor for your code }
  52.         sm_NumArgs      : Longint;      { the number of elements in ArgList }
  53.         sm_ToolWindow   : STRPTR;       { description of window }
  54.         sm_ArgList      : pWBArgList; { the arguments themselves }
  55.     end;
  56.  
  57.  
  58. Const
  59.  
  60.     WBDISK              = 1;
  61.     WBDRAWER            = 2;
  62.     WBTOOL              = 3;
  63.     WBPROJECT           = 4;
  64.     WBGARBAGE           = 5;
  65.     WBDEVICE            = 6;
  66.     WBKICK              = 7;
  67.     WBAPPICON           = 8;
  68.  
  69. Type
  70.  
  71.     pOldDrawerData = ^tOldDrawerData;
  72.     tOldDrawerData = record
  73.         dd_NewWindow    : tNewWindow;    { args to open window }
  74.         dd_CurrentX     : Longint;      { current x coordinate of origin }
  75.         dd_CurrentY     : Longint;      { current y coordinate of origin }
  76.     end;
  77.  
  78. Const
  79.  
  80. { the amount of DrawerData actually written to disk }
  81.  
  82.     OLDDRAWERDATAFILESIZE  = 56;  { sizeof(OldDrawerData) }
  83.  
  84. Type
  85.     pDrawerData = ^tDrawerData;
  86.     tDrawerData = record
  87.         dd_NewWindow    : tNewWindow;    { args to open window }
  88.         dd_CurrentX     : Longint;      { current x coordinate of origin }
  89.         dd_CurrentY     : Longint;      { current y coordinate of origin }
  90.         dd_Flags        : Longint;      { flags for drawer }
  91.         dd_ViewModes    : Word;        { view mode for drawer }
  92.     end;
  93.  
  94. Const
  95.  
  96. { the amount of DrawerData actually written to disk }
  97.  
  98.     DRAWERDATAFILESIZE  = 62;  { sizeof(DrawerData) }
  99.  
  100.  
  101. Type
  102.  
  103.     pDiskObject = ^tDiskObject;
  104.     tDiskObject = record
  105.         do_Magic        : Word;        { a magic number at the start of the file }
  106.         do_Version      : Word;        { a version number, so we can change it }
  107.         do_Gadget       : tGadget;       { a copy of in core gadget }
  108.         do_Type         : Byte;
  109.         do_DefaultTool  : STRPTR;
  110.         do_ToolTypes    : Pointer;
  111.         do_CurrentX     : Pointer;
  112.         do_CurrentY     : Longint;
  113.         do_DrawerData   : pDrawerData;
  114.         do_ToolWindow   : STRPTR;       { only applies to tools }
  115.         do_StackSize    : Longint;      { only applies to tools }
  116.     end;
  117.  
  118. Const
  119.  
  120.     WB_DISKMAGIC        = $e310;        { a magic number, not easily impersonated }
  121.     WB_DISKVERSION      = 1;            { our current version number }
  122.     WB_DISKREVISION     = 1;            { our current revision number }
  123.   {I only use the lower 8 bits of Gadget.UserData for the revision # }
  124.     WB_DISKREVISIONMASK = 255;
  125. Type
  126.     pFreeList = ^tFreeList;
  127.     tFreeList = record
  128.         fl_NumFree      : Integer;
  129.         fl_MemList      : tList;
  130.     end;
  131.  
  132. Const
  133.  
  134. { each message that comes into the WorkBenchPort must have a type field
  135.  * in the preceeding short.  These are the defines for this type
  136.  }
  137.  
  138.     MTYPE_PSTD          = 1;    { a "standard Potion" message }
  139.     MTYPE_TOOLEXIT      = 2;    { exit message from our tools }
  140.     MTYPE_DISKCHANGE    = 3;    { dos telling us of a disk change }
  141.     MTYPE_TIMER         = 4;    { we got a timer tick }
  142.     MTYPE_CLOSEDOWN     = 5;    { <unimplemented> }
  143.     MTYPE_IOPROC        = 6;    { <unimplemented> }
  144.     MTYPE_APPWINDOW     = 7;    {     msg from an app window }
  145.     MTYPE_APPICON       = 8;    {     msg from an app icon }
  146.     MTYPE_APPMENUITEM   = 9;    {     msg from an app menuitem }
  147.     MTYPE_COPYEXIT      = 10;   {     exit msg from copy process }
  148.     MTYPE_ICONPUT       = 11;   {     msg from PutDiskObject in icon.library }
  149.  
  150.  
  151. { workbench does different complement modes for its gadgets.
  152.  * It supports separate images, complement mode, and backfill mode.
  153.  * The first two are identical to intuitions GADGIMAGE and GADGHCOMP.
  154.  * backfill is similar to GADGHCOMP, but the region outside of the
  155.  * image (which normally would be color three when complemented)
  156.  * is flood-filled to color zero.
  157.  }
  158.  
  159.     GFLG_GADGBACKFILL   = $0001;
  160.     GADGBACKFILL        = $0001;   { an old synonym }
  161.  
  162. { if an icon does not really live anywhere, set its current position
  163.  * to here
  164.  }
  165.  
  166.     NO_ICON_POSITION    = $80000000;
  167.  
  168. {    If you find am_Version >= AM_VERSION, you know this structure has
  169.  * at least the fields defined in this version of the include file
  170.  }
  171.  AM_VERSION   =   1;
  172.  
  173. Type
  174.    pAppMessage = ^tAppMessage;
  175.    tAppMessage = record
  176.     am_Message       : tMessage;            {    standard message structure }
  177.     am_Type          : Word;              {    message type }
  178.     am_UserData      : ULONG;            {    application specific }
  179.     am_ID            : ULONG;            {    application definable ID }
  180.     am_NumArgs       : ULONG;            {    # of elements in arglist }
  181.     am_ArgList       : pWBArgList;       {    the arguements themselves }
  182.     am_Version       : Word;              {    will be AM_VERSION }
  183.     am_Class         : Word;              {    message class }
  184.     am_MouseX        : Integer;              {    mouse x position of event }
  185.     am_MouseY        : Integer;              {    mouse y position of event }
  186.     am_Seconds       : ULONG;            {    current system clock time }
  187.     am_Micros        : ULONG;            {    current system clock time }
  188.     am_Reserved      : Array[0..7] of ULONG;       {    avoid recompilation }
  189.    END;
  190.  
  191. {* types of app messages *}
  192. const
  193.     AMTYPE_APPWINDOW   = 7;    {* app window message    *}
  194.     AMTYPE_APPICON     = 8;    {* app icon message  *}
  195.     AMTYPE_APPMENUITEM = 9;    {* app menu item message *}
  196.  
  197. {
  198.  * The following structures are private.  These are just stub
  199.  * structures for code compatibility...
  200.  }
  201. type
  202.  
  203.  tAppWindow = record
  204.    aw_PRIVATE : Pointer;
  205.  END;
  206.  pAppWindow = ^tAppWindow;
  207.  
  208.  tAppIcon = record
  209.    ai_PRIVATE : Pointer;
  210.  END;
  211.  pAppIcon = ^tAppIcon;
  212.  
  213.  tAppMenuItem = record
  214.    ami_PRIVATE : Pointer;
  215.  END;
  216.  pAppMenuItem = ^tAppMenuItem;
  217.  
  218.  
  219. CONST
  220.     WORKBENCHNAME : PChar  = 'workbench.library';
  221.  
  222. VAR
  223.     WorkbenchBase : pLibrary;
  224.  
  225. FUNCTION AddAppIconA(id : ULONG; userdata : ULONG; text : pCHAR; msgport : pMsgPort; lock : pFileLock; diskobj : pDiskObject; taglist : pTagItem) : pAppIcon;
  226. FUNCTION AddAppMenuItemA(id : ULONG; userdata : ULONG; text : pCHAR; msgport : pMsgPort; taglist : pTagItem) : pAppMenuItem;
  227. FUNCTION AddAppWindowA(id : ULONG; userdata : ULONG; window : pWindow; msgport : pMsgPort; taglist : pTagItem) : pAppWindow;
  228. FUNCTION RemoveAppIcon(appIcon : pAppIcon) : BOOLEAN;
  229. FUNCTION RemoveAppMenuItem(appMenuItem : pAppMenuItem) : BOOLEAN;
  230. FUNCTION RemoveAppWindow(appWindow : pAppWindow) : BOOLEAN;
  231. PROCEDURE WBInfo(lock : BPTR; name : pCHAR; screen : pScreen);
  232.  
  233. {$ifdef amiga_overlays}
  234.  
  235. FUNCTION AddAppIconA(id : ULONG; userdata : ULONG; text : string; msgport : pMsgPort; lock : pFileLock; diskobj : pDiskObject; taglist : pTagItem) : pAppIcon;
  236. FUNCTION AddAppMenuItemA(id : ULONG; userdata : ULONG; text : string; msgport : pMsgPort; taglist : pTagItem) : pAppMenuItem;
  237. PROCEDURE WBInfo(lock : BPTR; name : string; screen : pScreen);
  238.  
  239. {$endif amiga_overlays}
  240.  
  241. IMPLEMENTATION
  242.  
  243. {$ifdef amiga_overlays}
  244. uses pastoc;
  245. {$endif}
  246.  
  247. FUNCTION AddAppIconA(id : ULONG; userdata : ULONG; text : pCHAR; msgport : pMsgPort; lock : pFileLock; diskobj : pDiskObject; taglist : pTagItem) : pAppIcon;
  248. BEGIN
  249.   ASM
  250.     MOVE.L  A6,-(A7)
  251.     MOVE.L  id,D0
  252.     MOVE.L  userdata,D1
  253.     MOVEA.L text,A0
  254.     MOVEA.L msgport,A1
  255.     MOVEA.L lock,A2
  256.     MOVEA.L diskobj,A3
  257.     MOVEA.L taglist,A4
  258.     MOVEA.L WorkbenchBase,A6
  259.     JSR -060(A6)
  260.     MOVEA.L (A7)+,A6
  261.     MOVE.L  D0,@RESULT
  262.   END;
  263. END;
  264.  
  265. FUNCTION AddAppMenuItemA(id : ULONG; userdata : ULONG; text : pCHAR; msgport : pMsgPort; taglist : pTagItem) : pAppMenuItem;
  266. BEGIN
  267.   ASM
  268.     MOVE.L  A6,-(A7)
  269.     MOVE.L  id,D0
  270.     MOVE.L  userdata,D1
  271.     MOVEA.L text,A0
  272.     MOVEA.L msgport,A1
  273.     MOVEA.L taglist,A2
  274.     MOVEA.L WorkbenchBase,A6
  275.     JSR -072(A6)
  276.     MOVEA.L (A7)+,A6
  277.     MOVE.L  D0,@RESULT
  278.   END;
  279. END;
  280.  
  281. FUNCTION AddAppWindowA(id : ULONG; userdata : ULONG; window : pWindow; msgport : pMsgPort; taglist : pTagItem) : pAppWindow;
  282. BEGIN
  283.   ASM
  284.     MOVE.L  A6,-(A7)
  285.     MOVE.L  id,D0
  286.     MOVE.L  userdata,D1
  287.     MOVEA.L window,A0
  288.     MOVEA.L msgport,A1
  289.     MOVEA.L taglist,A2
  290.     MOVEA.L WorkbenchBase,A6
  291.     JSR -048(A6)
  292.     MOVEA.L (A7)+,A6
  293.     MOVE.L  D0,@RESULT
  294.   END;
  295. END;
  296.  
  297. FUNCTION RemoveAppIcon(appIcon : pAppIcon) : BOOLEAN;
  298. BEGIN
  299.   ASM
  300.     MOVE.L  A6,-(A7)
  301.     MOVEA.L appIcon,A0
  302.     MOVEA.L WorkbenchBase,A6
  303.     JSR -066(A6)
  304.     MOVEA.L (A7)+,A6
  305.     TST.W   D0
  306.     BEQ.B   @end
  307.     MOVEQ   #1,D0
  308.   @end: MOVE.B  D0,@RESULT
  309.   END;
  310. END;
  311.  
  312. FUNCTION RemoveAppMenuItem(appMenuItem : pAppMenuItem) : BOOLEAN;
  313. BEGIN
  314.   ASM
  315.     MOVE.L  A6,-(A7)
  316.     MOVEA.L appMenuItem,A0
  317.     MOVEA.L WorkbenchBase,A6
  318.     JSR -078(A6)
  319.     MOVEA.L (A7)+,A6
  320.     TST.W   D0
  321.     BEQ.B   @end
  322.     MOVEQ   #1,D0
  323.   @end: MOVE.B  D0,@RESULT
  324.   END;
  325. END;
  326.  
  327. FUNCTION RemoveAppWindow(appWindow : pAppWindow) : BOOLEAN;
  328. BEGIN
  329.   ASM
  330.     MOVE.L  A6,-(A7)
  331.     MOVEA.L appWindow,A0
  332.     MOVEA.L WorkbenchBase,A6
  333.     JSR -054(A6)
  334.     MOVEA.L (A7)+,A6
  335.     TST.W   D0
  336.     BEQ.B   @end
  337.     MOVEQ   #1,D0
  338.   @end: MOVE.B  D0,@RESULT
  339.   END;
  340. END;
  341.  
  342. PROCEDURE WBInfo(lock : BPTR; name : pCHAR; screen : pScreen);
  343. BEGIN
  344.   ASM
  345.     MOVE.L  A6,-(A7)
  346.     MOVEA.L lock,A0
  347.     MOVEA.L name,A1
  348.     MOVEA.L screen,A2
  349.     MOVEA.L WorkbenchBase,A6
  350.     JSR -090(A6)
  351.     MOVEA.L (A7)+,A6
  352.   END;
  353. END;
  354.  
  355. {$ifdef amiga_overlays}
  356.  
  357. FUNCTION AddAppIconA(id : ULONG; userdata : ULONG; text : string; msgport : pMsgPort; lock : pFileLock; diskobj : pDiskObject; taglist : pTagItem) : pAppIcon;
  358. begin
  359.        AddAppIconA := AddAppIconA(id,userdata,pas2c(text),msgport,lock,diskobj,taglist);
  360. end;
  361.  
  362. FUNCTION AddAppMenuItemA(id : ULONG; userdata : ULONG; text : string; msgport : pMsgPort; taglist : pTagItem) : pAppMenuItem;
  363. begin
  364.        AddAppMenuItemA := AddAppMenuItemA(id,userdata,pas2c(text),msgport,taglist);
  365. end;
  366.  
  367. PROCEDURE WBInfo(lock : BPTR; name : string; screen : pScreen);
  368. begin
  369.        WBInfo(lock,pas2c(name),screen);
  370. end;
  371.  
  372. {$endif amiga_overlays}
  373.  
  374. END. (* UNIT WB *)
  375.  
  376.  
  377.  
  378.